00010	BEGIN "LEVEL2"
00020	DEFINE ⊂="COMMENT";  ⊂ 8/16/73 FIRST DRAFT;
00030	PROCEDURE LEVEL2;
00040	BEGIN "LEV"
00050	⊂ This procedure accumulates statistics on adjacency probabilities
00060	   for segment types during the training stage and uses these apriori
00070	   values to modify the individual estimates during use;
00075	⊂ Probabilities are expressed in parts per 512;
00080	
00090	EXTERNAL STRING NU;
00100	EXTERNAL INTEGER N,CFLAG,SEGC,FLAG;
00110	DEFINE TABNUM="16";
00120	EXTERNAL INTEGER ARRAY NAMES,CMAX,OUT1,OUT2,OUT3,OUT4[0:TABNUM];
00130	EXTERNAL INTEGER ARRAY HINTS[0:31];
00140	INTEGER I,J,K,L,M,Q;
00150	INTEGER BSTCNT,BSTHNT;
00160	INTEGER ARRAY HINT2,DUR2,SEGC2,TMP,CNT[0:31];
00170	INTEGER ARRAY CMAX2[0:16,0:31];
00180	INTEGER ARRAY BESTN,BESTP[0:7,0:31]; ⊂ Names and prob.values for the
00190	   n best choices, kept ordered by sort after the initial merge;
00200	INTEGER ARRAY CONTEX[0:63,0:63];  ⊂ Sums accumulated in right half
00210	   and adjacency conditional probabilities in 2 fields in left half;
00220	INTEGER ARRAY PROB[0:63]; ⊂ The a priori probabilities of features;
00230	
00240	
00250	PROCEDURE MERGE;
00260	BEGIN "MERGE"  ⊂ used to keep values ordered as they are accumulated;
00270	INTEGER K;
00280	
00290	BESTP[7,N]←J; BESTN[7,N]←L;
00300	FOR K←7 STEP -1 UNTIL 1 DO IF BESTP[K,N]> BESTP[K-1,N] THEN BEGIN
00310	  L←BESTN[K-1,N]; BESTN[K-1,N]←BESTN[K,N]; BESTN[K,N]←L;
00320	  J←BESTP[K-1,N]; BESTP[K-1,N]←BESTP[K,N]; BESTP[K,N]←J; END
00330	  ELSE DONE;
00340	END "MERGE";
00350	
00360	
00370	PROCEDURE SORT;  
00380	BEGIN "SORT"  ⊂ used to reorder values after adjacency corrections;
00390	INTEGER I,J,K;
00400	
00410	FOR I←0 STEP 1 UNTIL 6 DO
00420	  FOR J←I+1 STEP 1 UNTIL 7 DO IF BESTP[I,N]< BESTP[J,N] THEN BEGIN
00430	    K←BESTN[I,N]; BESTN[I,N]←BESTN[J,N]; BESTN[J,N]←K;
00440	    K←BESTP[I,N]; BESTP[I,N]←BESTP[J,N]; BESTP[J,N]←K; END;
00450	END "SORT";
00460	
00470	
00480	PROCEDURE SETUP;
00490	BEGIN "SETUP"  ⊂ computes direct and adjacency probabilities;
00500	INTEGER I,J,K,ISUM,JSUM,SUM;
00510	
00520	SUM←0;
00530	FOR I←0 STEP 1 UNTIL 63 DO SUM←SUM+PROB[I] LAND '777777;
00540	FOR I←0 STEP 1 UNTIL 63 DO BEGIN
00550	  J←PROB[I] LAND '777777; K←J*512%SUM; IF K>511 THEN K←511;
00555	   PROB[I]←J+(K LSH 27); END;
00557	
00570	FOR I←0 STEP 1 UNTIL 63 DO BEGIN
00580	  JSUM←0;
00590	  FOR J←0 STEP 1 UNTIL 63 DO JSUM←JSUM+CONTEX[I,J] LAND '777777;
00600	  FOR J←0 STEP 1 UNTIL 63 DO BEGIN
00610	    K←((CONTEX[I,J] LAND '777777)*512)%JSUM;
00615	    IF K>511 THEN K←511;
00620	    CONTEX[I,J]←(CONTEX[I,J] LAND '777777777)+(K LSH 27);
00630	    END;
00640	  END;
00650	
00660	FOR J←0 STEP 1 UNTIL 63 DO BEGIN
00670	  ISUM←0;
00680	  FOR I←0 STEP 1 UNTIL 63 DO ISUM←CONTEX[I,J] LAND '777777;
00690	  FOR I←0 STEP 1 UNTIL 63 DO BEGIN
00700	    K←((CONTEX[I,J] LAND '777777)*512)%ISUM;
00705	    IF K>511 THEN K←511;
00710	    CONTEX[I,J]←( CONTEX[I,J] LAND '777000777777)+(K LAND 18);
00720	    END;
00730	  END;
00740	END "SETUP";
00750	
00760	
00770	IF CFLAG≠0 THEN BEGIN "CFLAG"   ⊂ to proceess another segment;
00780	FOR J←0 STEP 1 UNTIL 7 DO BESTP[J,N]←0;
00790	 SEGC2[N]←SEGC; DUR2[N]←SEGC2[N]-SEGC2[N-1];
00800	 FOR I←0 STEP 1 UNTIL TABNUM-1 DO  BEGIN
00810	   IF NAMES[I]=0 THEN DONE;
00820	   FOR J←0 STEP 1 UNTIL 7 DO BEGIN
00830	     IF (J←LDB(POINT(9,CMAX[I],8)))>BESTP[7,N] THEN BEGIN
00840	       L←OUT1[I]; MERGE; END;
00850	       
00860	     IF (J←LDB(POINT(9,CMAX[I],17)))>BESTP[7,N] THEN BEGIN
00870	       L←OUT2[I]; MERGE; END;
00880	     IF (J←LDB(POINT(9,CMAX[I],26)))>BESTP[7,N] THEN BEGIN
00890	       L←OUT3[I]; MERGE; END;
00900	     IF (J←LDB(POINT(9,CMAX[I],35)))>BESTP[7,N] THEN BEGIN
00910	       L←OUT4[I]; MERGE; END;
00920	     END;
00930	   END;
00940	
00950	IF FLAG=-1 THEN BEGIN "FLAG-1"
00960	  L←0; TMP[L]←HINTS[DUR2[N]];
00970	  FOR J← DUR2[N] STEP -1 UNTIL 0 DO 
00980	    IF HINTS[J]=TMP[L] THEN CNT[L]←CNT[L]+1 ELSE BEGIN
00990	      L←L+1; CNT[L]←1; TMP[L]←HINTS[J]; END;
01000	  BSTHNT←BSTCNT←0;
01010	  FOR J←L STEP -1 UNTIL 0 DO
01020	    IF CNT[J]>BSTCNT THEN BEGIN BSTCNT←CNT[J]; BSTHNT←TMP[J]; END;
01030	HINT2[N]←BSTHNT;
01040	J←HINTS[N-1]; K←BSTHNT; PROB[K]←PROB[K]+1;
01050	CONTEX[J,K]←CONTEX[J,K]+1;
01060	  END "FLAG-1";
01070	
01080	IF FLAG=1 THEN IF N>1 THEN BEGIN "FLAG1"    ⊂ correct for context;
01090	
01100	  FOR I←0 STEP 1 UNTIL 7 DO BEGIN
01110	    K←BESTN[I,N-1];
01120	    Q←LDB(POINT(9,PROB[K],8));
01130	    FOR J←0 STEP 1 UNTIL 7 DO BEGIN  ⊂ backward adjustment;
01140	      L←BESTN[J,N];
01150	      M←LDB(POINT(9,CONTEX[K,L],8));
01160	      BESTP[I,N-1]← BESTP[I,N-1]+
01170	       ((1-BESTP[I,N-1])*(((M*BESTP[J,N]) LSH -9)-Q) LSH -9);
01180	  END; END; SORT;
01190	
01200	  FOR J←0 STEP 1 UNTIL 7 DO BEGIN
01210	    L←BESTN[J,N];
01220	    Q←LDB(POINT(9,PROB[L],17));
01230	    FOR I←0 STEP 1 UNTIL 7 DO BEGIN  ⊂ forward adjustment;
01240	      K←BESTN[I,N-1];
01250	      M←LDB(POINT(9,CONTEX[K,L],17));
01260	      BESTP[J,N]←BESTP[J,N]+
01270	       ((1-BESTP[J,N])*(((M*BESTP[I,N-1]) LSH -9)-Q) LSH -9);
01280	  END; END; SORT;
01290	
01300	END "FLAG1";
01310	 N←N+1;
01320	END "CFLAG";
01330	
01340	
01350	
01360	END "LEV";
01370	END "LEVEL2";
01380	
01390	⊂ ************I;
01400	⊂ PUT IN SAY ;
01410	⊂ AT 401/2;
01420	⊂ HINTS[HCNT]←J;
01430	⊂ HCNT←HCNT+1;